home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / hugecoll.zip / HUGECOLL.PAS < prev   
Pascal/Delphi Source File  |  1992-07-25  |  18KB  |  748 lines
  1. L{File name :HUGECOLL.PAS; Revision Date 23/5/1992 Size :556 Lines }
  2. unit hugecoll; {implement huge collection in TurboPascal for Windows}
  3.  
  4. interface
  5.  
  6. {----------Huge Collection and Huge SortedCollection Object----------}
  7. {      May 1992                                                      }
  8. {      Ver 0.1       (c) Nicholas Waltham, Oxford, United Kingdom    }
  9. {                        <SPEEDY%UK.AC.OX.VAX@UKACRL>                }
  10. {                        <100013.3330@COM.COMPUSERVE>                }
  11. {                                                                    }
  12. {                    Thanks to Jeroen Pluimers and other members of  }
  13. {                    the Usenet community for memory handling advice }
  14. {--------------------------------------------------------------------}
  15.  
  16. { NB                                                                    }
  17. {                                                                       }
  18. { o Programs compiled with the only386 option defined will not run in   }
  19. {   real mode - but who runs a 386 in real mode anyway!                 }
  20.  
  21. { o If anyone makes any significant alterations or has any bright ideas }
  22. {   then please forward them to me so I can keep one up to date copy    }
  23.  
  24. { o This is supplied as is - there is no warrenty expressed or implied  }
  25.  
  26. { o This code is released to the public domain and may be freely copied }
  27. {   No money must be charged for this code                              }
  28.  
  29.  
  30. uses
  31.  Wintypes,WinProcs,WObjects,Strings;
  32.  
  33. {$I p:\shared\objid.inc}
  34.  { This is a Pascal '.INC' file containing contants for all my object ids I have ever written
  35.    and prevents me from assigning the same id twice. You will need to define oidHugeCollection
  36.    and oidHugeSortedCollection constants for this unit}
  37.  
  38. {
  39. {$DEFINE Only386}
  40.  
  41.  {Define this flag is the subsequent code is only going to run on a 386base computer
  42.   or above - includes pointer calculation optimisation}
  43.  
  44.  
  45. type
  46.   LongType = record
  47.     case Word of
  48.       0: (Ptr: Pointer);
  49.       1: (Long: Longint);
  50.       2: (Lo: Word;
  51.       Hi: Word);
  52.   end;
  53.  
  54.  ppointer = ^pointer;
  55.  
  56.  
  57.  pHugeCollection = ^tHugeCollection;
  58.  tHugeCollection = Object (tObject)
  59.  
  60.  
  61.                    Items  : tHandle; {Handle to Global Memory}
  62.                    Count  : longint; {Current Number of Items}
  63.                    Limit  : longint; {Current Allocated size}
  64.                    Delta  : longint; {Number of items by which the collection grows when full}
  65.  
  66.  
  67.                    base   : longtype;  {global pointer to memory when locked}
  68.  
  69.  
  70.                    constructor init(aLimit, aDelta : Longint);
  71.  
  72.                    constructor Load(Var S : tStream);
  73.  
  74.  
  75.                    destructor  done; virtual;
  76.  
  77.                    function    At            (Index : Longint) : Pointer;
  78.                    procedure   AtDelete      (Index : Longint);
  79.                    procedure   AtInsert      (Index : Longint; Item : Pointer);
  80.                    procedure   AtPut         (Index : Longint; Item : Pointer);
  81.                    procedure   Delete        (Item : Pointer);
  82.                    procedure   DeleteAll;
  83.                    procedure   Error         (Code,Info : Integer); virtual;
  84.                    function    FirstThat     (Test : Pointer) : Pointer;
  85.                    procedure   ForEach       (Action : Pointer);
  86.                    procedure   Free          (Item : Pointer);
  87.                    procedure   FreeAll;
  88.                    procedure   FreeItem      (Item : Pointer); virtual;
  89.                    function    GetItem       (Var S : tStream) : Pointer; virtual;
  90.                    function    IndexOf       (Item : Pointer) : longint; virtual;
  91.                    procedure   Insert        (Item : Pointer); virtual;
  92.                    function    LastThat      (Test : Pointer) : Pointer;
  93.                    procedure   Pack;
  94.                    procedure   PutItem       (Var S : tStream; Item : Pointer); virtual;
  95.                    procedure   SetLimit      (aLimit : Longint);virtual;
  96.  
  97.                    procedure   Store         (Var S : tStream);
  98.  
  99.                    procedure   AtZero        (Index : Longint);
  100.  
  101.                    procedure   Lock;
  102.                    procedure   UnLock;
  103.  
  104.                    end;
  105.  
  106.  
  107.  
  108.  pHugeSortedCollection = ^tHugeSortedCollection;
  109.  
  110.  tHugeSortedCollection = Object(tHugeCollection)
  111.  
  112.  
  113.                          function       Compare (Key1,Key2 : Pointer): Integer; virtual;
  114.                          function       IndexOf (Item : Pointer): Longint; virtual;
  115.                          procedure      Insert  (Item : Pointer); virtual;
  116.                          function       KeyOf   (Item : Pointer): Pointer; virtual;
  117.                          function       Search  (key : Pointer; Var Index : Longint) : Boolean; virtual;
  118.  
  119.  
  120.                          end;
  121.  
  122.  
  123.  
  124. pCharHugeCollection        = ^tCharHugeCollection;
  125. tCharHugeCollection        = Object(tHugeCollection)
  126.  
  127.                              procedure   FreeItem      (Item : Pointer); virtual;
  128.  
  129.                              end;
  130.  
  131. pStrHugeCollection         = ^tStrHugeCollection;
  132. tStrHugeCollection         = Object(tHugeSortedCollection)
  133.  
  134.  
  135.                               function       Compare       (Key1,Key2 : Pointer): Integer; virtual;
  136.                               procedure      FreeItem      (Item : Pointer); virtual;
  137.  
  138.                               end;
  139.  
  140.  
  141.  
  142. const
  143.  RHugeCollection : tStreamRec =
  144.   (ObjType : oidHugeCollection;
  145.    VmtLink : Ofs(Typeof(tHugeCollection)^);
  146.    Load    : @tHugeCollection.load;
  147.    Store   : @tHugeCollection.Store);
  148.  
  149.  RHugeSortedCollection : tStreamRec =
  150.  
  151.   (ObjType : oidHugeSortedCollection;
  152.    VmtLink : Ofs(Typeof(tHugeSortedCollection)^);
  153.    Load    : @tHugeSortedCollection.load;
  154.    Store   : @tHugeSortedCollection.Store);
  155.  
  156.  
  157.  
  158. implementation
  159.  
  160.  
  161. Procedure _AHShift;  External 'KERNEL' Index 113;
  162. procedure _AHIncr;far; external 'Kernel' index 114; {The MAGINC! function}
  163.  
  164. const
  165.  cAHShift = {Ofs(_AHShift)}3 ;{This won't work in real mode!}
  166.   AHShift : word = cAHShift;
  167.  cAHIncr  = {Ofs(_AHShift)}8 ;{This won't work in real mode!}
  168.   AHIncr  : word = cAHIncr;
  169.  
  170.  
  171. {$IFDEF Only386}
  172.  
  173.  function Compute(base : Pointer;aIndex : Longint) : Pointer;
  174.  inline(
  175.  $66/$5B                      {Pop EBX                  ; Load EBX with Index}
  176.  /$58                         {Pop AX                   ; Load AX  with Offset(base)
  177.                                                          (Sensible since pointers are returned as DX:AX}
  178.  /$5A                         {Pop DX                   ; Load DX  with Segment(base) }
  179.  /$66/$C1/$E3/$02             {SHL EBX,2                ; Multiply EBX by 4           }
  180.  /$03/$C3                     {ADD AX,BX                ; Add Lower half of pointer to AX}
  181.  /$33/$DB                     {XOR BX,BX                ; Zero bottom 16bits of EBX      }
  182.  /$66/$C1/$EB/<($10-cAHShift) {SHR EBX,16 - AHShift     ; Shift Top of EBX into BX compensating for AHShift}
  183.                                                          {This won't work in real mode}
  184.  /$03/$D3                     {ADD DX,BX                ; Add to BX}
  185.  );
  186.  
  187. {$ELSE}
  188.  function Compute(base : Pointer;aIndex : Longint) : Pointer;
  189.  INLINE(
  190. $5B                     { POP BX                             }
  191. /$5A                    { POP DX                             }
  192. /$58                    { POP AX                             }
  193. /$D1/$E3                { SHL BX,1                           }
  194. /$D1/$D2                { RCL DX,1                           }
  195. /$D1/$E3                { SHL BX,1                           }
  196. /$D1/$D2                { RCL DX,1                           }
  197. /$03/$C3                { ADD AX,BX                          }
  198. /$8B/$DA                { MOV BX,DX                          }
  199. /$5A                    { POP DX                             }
  200. /$8B/$0E/>AHShift       { MOV CX,word([AHSHIFT])             }
  201. /$D3/$E3                { SHL BX,CL                          }
  202. /$03/$D3                { ADD DX,BX